home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1994 January / PSL Monthly Shareware CD-ROM (Public Software Library) (January 1994).iso / games / dos / ascii_ga / snakes.com / SNAKES.BAS < prev   
Encoding:
BASIC Source File  |  1989-01-17  |  9.5 KB  |  187 lines
  1. 10 ' DOCUMENTATION
  2. 20 'Snakes - a traditional computer game
  3. 30 '(c) 1982 Peter Quinn
  4. 40 ' Modified 1984 Bill Barker
  5. 50 ' Modified 1985 Gregory Berryhill. Added weighted scores, title screen,
  6. 60 '               instructions screen, scoring line, goto-less programming
  7. 70 '               (except loop-completing gotos), game parameters screen,
  8. 80 '               end of execution screen, fixed the "both-move-to-the-same
  9. 90 '               square-at-the-same-time" bug, and added remarks
  10. 100 ' MAINLINE
  11. 110 GOSUB 8000:' INITIALIZATION
  12. 120 GOSUB 7000:' TITLE SCREEN
  13. 130 GOSUB 6000:' INSTRUCTIONS SCREEN
  14. 140 GOSUB 200:'  GAME LOOP
  15. 150 GOSUB 5000:' END OF EXECUTION SCREEN
  16. 160 SYSTEM
  17. 170 END
  18. 200 ' GAME LOOP
  19. 210 GOSUB 2000:' GAME PARAMETERS SCREEN
  20. 220 GOSUB 1000:' PLAY GAME
  21. 230 IF A$="S" OR A$="s" THEN GOSUB 4000
  22. 240 IF A$=CR$ THEN GOTO 220
  23. 250 IF A$="C" OR A$="c" THEN GOTO 210
  24. 260 RETURN
  25. 1000 ' GAME SCREEN INITIALIZATION
  26. 1010 P1=2010:D1=2
  27. 1020 P2=1990:D2=-2
  28. 1030 R!=.8:GC=GC+1:N=0
  29. 1040 ' PRINT SCORE HEADING
  30. 1050 CLS:COLOR FC:PRINT"         SCORE      HIGH SCORE      SPD     WTD SCORE       HIGH WTD SCORE      ";
  31. 1060 LOCATE 1,2:COLOR YC:PRINT"S A E";:LOCATE 1,3:COLOR CC:PRINT"N";:LOCATE 1,5:PRINT"K";:LOCATE 1,7:PRINT"S";
  32. 1070 COLOR YC:LOCATE 1,32:PRINT USING N4$;YHS;:LOCATE 1,41:PRINT USING N3$;Z;:LOCATE 1,76:PRINT USING N5$;YWHS;:COLOR FC
  33. 1080 ' DRAW HORIZONTAL BORDER
  34. 1090 FOR I=0 TO 160 STEP 2:POKE I+HB2,LC:POKE I+HB1,C
  35. 1100 POKE I+HB4,LC:POKE I+HB3,C:NEXT I
  36. 1110 ' DRAW VERTICAL BORDER
  37. 1120 FOR I=160 TO 4000 STEP 160:POKE I+VB1,LC:POKE I,C
  38. 1130 POKE I+VB3,LC:POKE I+VB2,C:NEXT I
  39. 1140 ' MAINLINE - MAKE A MOVE
  40. 1150 R!=R!+(1-R!)/20:N=N+1
  41. 1160 P1=P1+D1:IF PEEK(P1)<>32 THEN GOSUB 1320:RETURN
  42. 1170 POKE P1+1,YC:POKE P1,A
  43. 1180 P2=P2+D2:IF PEEK(P2)<>32 THEN GOSUB 1340:RETURN
  44. 1190 POKE P2+1,CC:POKE P2,B
  45. 1200 GOSUB 1360;' WILL COMPUTER CHANGE DIRECTION?
  46. 1210 FOR I=1 TO Z:NEXT I:' SLOW DOWN MOVES
  47. 1220 GOTO 1150
  48. 1230 ' CHANGE YOUR DIRECTION TO UP
  49. 1240 D1=-160:RETURN
  50. 1250 ' CHANGE YOUR DIRECTION TO LEFT
  51. 1260 D1=-2:RETURN
  52. 1270 ' CHANGE YOUR DIRECTION TO RIGHT
  53. 1280 D1=2:RETURN
  54. 1290 ' CHANGE YOUR DIRECTION TO DOWN
  55. 1300 D1=160:RETURN
  56. 1310 ' YOU LOSE
  57. 1320 GOSUB 3020:COLOR CC:LOCATE 1,1:PRINT "YOU LOSE";:COLOR YC:YN=N/10:CN=N:GOSUB 1460:CW=CW+1:RETURN
  58. 1330 ' YOU WIN
  59. 1340 GOSUB 3050:COLOR (YC+16):LOCATE 1,1:PRINT "YOU WIN";:COLOR YC:YN=N:CN=N/10:GOSUB 1460:YW=YW+1:RETURN
  60. 1350 ' WILL THE COMPUTER SNAKE CHANGE DIRECTION?
  61. 1360 IF PEEK(P2+D2)=32 AND RND<R! THEN RETURN
  62. 1370 IF ABS(D2)=2 THEN D2=160:GOSUB 1420: RETURN
  63. 1380 IF ABS(D2)=160 THEN D2=2
  64. 1390 IF P2<2000 AND D2=160 THEN D2=-D2
  65. 1400 IF PEEK(D2+P2)<>32 THEN D2=-D2
  66. 1410 RETURN
  67. 1420 DI=P2/160
  68. 1430 IF DI>12 THEN D2=-D2
  69. 1440 IF PEEK(D2+P2)<>32 THEN D2=-D2
  70. 1450 RETURN
  71. 1460 ' END OF GAME
  72. 1470 YPT!=YPT!+YN:CPT!=CPT!+CN
  73. 1480 YHSC=YC:IF YN>YHS THEN YHS=YN:YHSC=YC+16
  74. 1490 YWHSC=YC:YWS=YN*WF!:YWT!=YWT!+YWS:IF YWS>YWHS THEN YWHS=YWS:YWHSC=YC+16
  75. 1500 COLOR YC:LOCATE 1,16:PRINT USING N4$;YN;:LOCATE 1,32:COLOR YHSC:PRINT USING N4$;YHS;:LOCATE 1,41:COLOR YC:PRINT USING N3$;Z;:LOCATE 1,55:PRINT USING N5$;YWS;:LOCATE 1,76:COLOR YWHSC:PRINT USING N5$;YWHS;:COLOR FC
  76. 1520 IF CN>CHS THEN CHS=CN
  77. 1530 CWS=CN*WF!:CWT!=CWT!+CWS:IF CWS>CWHS THEN CWHS=CWS
  78. 1540 A$=INKEY$:IF A$>"" THEN 1540:' GET RID ACCIDENTALLY PRESSED KEYS
  79. 1550 COLOR BC,LC:LOCATE 2,2:PRINT"=> Press <ENTER> to run again; C to Change; Q to Quit; or S for Statistics <=";:COLOR FC,BC
  80. 1560 A$=INKEY$:IF A$="" THEN 1560
  81. 1570 IF A$="q" OR A$="Q" OR A$="s" OR A$="S" OR A$="c" OR A$="C" OR A$=CR$ THEN RETURN ELSE GOTO 1560
  82. 2000 ' GAME MENU SCREEN
  83. 2010 GOSUB 3070:LOCATE 2,25:PRINT"G A M E   P A R A M E T E R S"
  84. 2020 LOCATE 10,1:PRINT "Do you want sound effects?    (Y for Yes, N for No, <ENTER> for ";SD$;")  ? ";
  85. 2030 A$=INKEY$:IF A$="" THEN GOTO 2030
  86. 2040 IF A$<>"n" AND A$<>"N" AND A$<>"y" AND A$<>"Y" AND A$<>CR$ THEN COLOR (FC+16):GOTO 2020 ELSE COLOR FC:PRINT A$
  87. 2050 IF A$<>CHR$(13) THEN IF A$="n" OR A$="N" THEN SND=0:SD$="N" ELSE SND=1:SD$="Y"
  88. 2060 LOCATE 12,1:PRINT "How fast do you want to move? (1-100, 1 is fastest, <ENTER> for ";:PRINT USING N3$;Z;:PRINT")";:INPUT;A$
  89. 2070 IF A$<>"" THEN I=VAL(A$):IF I>100 OR I<1 THEN COLOR (FC+16):GOTO 2060 ELSE Z=I
  90. 2090 IF Z>LS THEN LS=Z
  91. 2100 IF Z<HS THEN HS=Z
  92. 2110 WF!=(((100-Z)/100)*3)+1
  93. 2120 CS!=CS!+Z
  94. 2130 RETURN
  95. 3000 ' SUBROUTINES
  96. 3010 ' YOU LOSE SOUND SUBROUTINE
  97. 3020 FOR I=100 TO 50 STEP -5:SOUND I,SND:NEXT
  98. 3030 FOR I=1 TO 8:SOUND 37,SND:SOUND 39,SND:NEXT:RETURN
  99. 3040 ' YOU WIN SOUND SUBROUTINE
  100. 3050 FOR I=200 TO 300 STEP 20:SOUND I,SND:NEXT:SOUND 32767,SND*2
  101. 3060 FOR I=1 TO 2:SOUND 400,3*SND:SOUND 600,4*SND:SOUND 32767,SND:NEXT:RETURN
  102. 3070 ' SNAKES HEADING
  103. 3080 COLOR FC,BC,BC:CLS
  104. 3090 COLOR YC:LOCATE 1,34:PRINT"S";:LOCATE 1,38:PRINT"A";:LOCATE 1,42:PRINT"E";:COLOR CC:LOCATE 1,36:PRINT"N";:LOCATE 1,40:PRINT"K";:LOCATE 1,44:PRINT"S":COLOR FC
  105. 3100 RETURN
  106. 4000 ' STATISTICS SCREEN
  107. 4010 GOSUB 3070
  108. 4020 LOCATE 2,32:PRINT"GAME STATISTICS"
  109. 4030 LOCATE 5,46:COLOR YC:PRINT"YOU";:LOCATE 5,57:COLOR CC:PRINT"COMPUTER":COLOR FC
  110. 4040 LOCATE 7,16:PRINT"WINS"
  111. 4050 LOCATE 8,16:PRINT"HIGH SCORE"
  112. 4060 LOCATE 9,16:PRINT"WEIGHTED HIGH SCORE"
  113. 4070 LOCATE 10,16:PRINT"AVERAGE SCORE"
  114. 4080 LOCATE 11,16:PRINT"AVERAGE WEIGHTED SCORE"
  115. 4090 YSC=YC:CSC=CC:IF YW>CW THEN YSC=YC+16 ELSE IF YW<CW THEN CSC=CC+16
  116. 4100 LOCATE 7,44:COLOR YSC:PRINT USING N5$;YW;:LOCATE 7,60:COLOR CSC:PRINT USING N5$;CW;
  117. 4110 YSC=YC:CSC=CC:IF YHS>CHS THEN YSC=YC+16 ELSE IF YHS<CHS THEN CSC=CC+16
  118. 4120 LOCATE 8,44:COLOR YSC:PRINT USING N5$;YHS;:LOCATE 8,60:COLOR CSC:PRINT USING N5$;CHS;
  119. 4130 YSC=YC:CSC=CC:IF YWHS>CWHS THEN YSC=YC+16 ELSE IF YWHS<CWHS THEN CSC=CC+16
  120. 4140 LOCATE 9,44:COLOR YSC:PRINT USING N5$;YWHS;:LOCATE 9,60:COLOR CSC:PRINT USING N5$;CWHS;
  121. 4150 YAS=0:IF GC>0 THEN YAS=INT(YPT!/GC)
  122. 4160 CAS=0:IF GC>0 THEN CAS=INT(CPT!/GC)
  123. 4170 YSC=YC:CSC=CC:IF YAS>CAS THEN YSC=YC+16 ELSE IF YAS<CAS THEN CSC=CC+16
  124. 4180 LOCATE 10,44:COLOR YSC:PRINT USING N5$;YAS;:LOCATE 10,60:COLOR CSC:PRINT USING N5$;CAS;
  125. 4190 YWS=0:IF GC>0 THEN YWS=INT(YWT!/GC)
  126. 4200 CWS=0:IF GC>0 THEN CWS=INT(CWT!/GC)
  127. 4210 YSC=YC:CSC=CC:IF YWS>CWS THEN YSC=YC+16 ELSE IF YWS<CWS THEN CSC=CC+16
  128. 4220 LOCATE 11,44:COLOR YSC:PRINT USING N5$;YWS;:LOCATE 11,60:COLOR CSC:PRINT USING N5$;CWS;:COLOR FC
  129. 4230 LOCATE 15,31:COLOR FC:PRINT"FASTEST SPEED ";:PRINT USING N3$;HS
  130. 4240 I=0:IF GC>0 THEN I=INT(CS!/GC)
  131. 4250 LOCATE 16,31:COLOR FC:PRINT"AVERAGE SPEED ";:PRINT USING N3$;I
  132. 4260 LOCATE 17,31:COLOR FC:PRINT"SLOWEST SPEED ";:PRINT USING N3$;LS
  133. 4270 PRINT:LOCATE 23,16:PRINT"Press <ENTER> to Continue; C to Change; Q to Quit";
  134. 4280 A$=INKEY$:IF A$="" THEN GOTO 4280 ELSE IF A$="c" OR A$="C" OR A$="Q" OR A$="q" OR A$=CR$ THEN RETURN ELSE GOTO 4280
  135. 5000 ' END OF EXECUTION SCREEN
  136. 5010 GOSUB 3070
  137. 5020 COLOR FC:LOCATE 11,21:PRINT"We hope you enjoyed playing        ..."
  138. 5030 LOCATE 11,49:COLOR YC:PRINT"S A E";:LOCATE 11,50:COLOR CC:PRINT"N";:LOCATE 11,52:PRINT"K";:LOCATE 11,54:PRINT"S";:COLOR FC
  139. 5040 LOCATE 13,41:PRINT"Peter, Bill, and Gregory"
  140. 5050 LOCATE 23,27:PRINT"Press <ENTER> to Continue"
  141. 5060 A$=INKEY$:IF A$=""THEN GOTO 5060
  142. 5070 IF A$=CR$ THEN RETURN ELSE GOTO 5060
  143. 6000 ' INSTRUCTIONS SCREEN
  144. 6010 GOSUB 3070:LOCATE 2,28: PRINT"I N S T R U C T I O N S":PRINT
  145. 6020 PRINT:PRINT"  (1) You are competing against the computer."
  146. 6030 PRINT:PRINT"  (2) Both you and the computer start moving  from the middle of the screen, "
  147. 6040 PRINT"      leaving a trail  (or snake) behind you.  You can control the direction"
  148. 6050 PRINT"      of your movement by the cursor (arrow) keys."
  149. 6060 PRINT:PRINT"  (3) Whoever bumps into a wall or a snake first,  loses.  The loser's score"
  150. 6070 PRINT"      is divided by ten."
  151. 6080 PRINT:PRINT"  (4) The longer the game continues, the higher the score."
  152. 6090 PRINT:PRINT"  (5) The faster the speed, the higher the weighted score."
  153. 6100 PRINT:PRINT"  (6) Two players  of varying  skill levels  (adult  and young child?) could"
  154. 6110 PRINT"      each play a game, and compete against each other. Each would play at a"
  155. 6120 PRINT"      different  speed.  Both could win.  The lower skilled  could have  the"
  156. 6130 PRINT"      highest score; the higher skilled, the highest weighted score."
  157. 6140 PRINT:LOCATE 23,27:PRINT"Press <ENTER> to Continue"
  158. 6150 A$=INKEY$:IF A$=""THEN GOTO 6150
  159. 6160 IF A$=CR$ THEN RETURN ELSE GOTO 6150
  160. 7000 ' TITLE SCREEN
  161. 7010 SCREEN 0,0,0:WIDTH 80:COLOR FC,BC,BC:CLS
  162. 7020 COLOR YC:LOCATE 8,34:PRINT"S";:LOCATE 8,38:PRINT"A";:LOCATE 8,42:PRINT"E";:COLOR CC:LOCATE 8,36:PRINT"N";:LOCATE 8,40:PRINT"K";:LOCATE 8,44:PRINT"S":COLOR FC
  163. 7030 LOCATE 10,15:PRINT"a   t r a d i t i o n a l   c o m p u t e r   g a m e"
  164. 7040 LOCATE 12,25:PRINT"Copyright 1982 Peter Quinn"
  165. 7050 LOCATE 13,25:PRINT"Modified  1984 Bill Barker"
  166. 7060 LOCATE 14,25:PRINT"Modified  1985 Gregory Berryhill"
  167. 7070 LOCATE 23,27:PRINT"Press <ENTER> to continue"
  168. 7080 A$=INKEY$:IF A$="" THEN GOTO 7080
  169. 7090 IF A$=CR$ THEN RETURN ELSE GOTO 7080
  170. 7100 RETURN
  171. 8000 ' INITIALIZATION
  172. 8010 DEFINT A-Z
  173. 8020 TI=VAL(RIGHT$(TIME$,2))
  174. 8030 RANDOMIZE TI
  175. 8040 OPTION BASE 1
  176. 8050 A=178:B=177:C=219:GC=0:Z=100:LS=0:HS=100:CS!=0:SND=1:FC=10:BC=0:YC=9:CC=12:LC=2
  177. 8060 HB1=160:HB2=160+1:HB3=4000-160:HB4=4000-160+1:VB1=1:VB2=158:VB3=158+1
  178. 8070 DEF SEG=&H40
  179. 8080 IF (PEEK(&H10) AND &H30)=&H30 THEN DEF SEG=&HB000:FC=7:LC=7 ELSE DEF SEG=&HB800
  180. 8090 CR$=CHR$(13):SD$="Y":N3$="###":N4$="####":N5$="#####"
  181. 8100 KEY OFF
  182. 8110 FOR I=11 TO 14:KEY(I) ON:NEXT I:'SETS TRAPPING OF CURSOR KEYS
  183. 8120 ' IF CURSOR KEY PRESSED, THEN GOSUB TO CURSOR ROUTINE
  184. 8130 ON KEY(11) GOSUB 1240:ON KEY(12) GOSUB 1260
  185. 8140 ON KEY(13) GOSUB 1280:ON KEY(14) GOSUB 1300
  186. 8150 RETURN
  187.